home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / turbotut.arc / OT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-06-30  |  25.7 KB  |  704 lines
  1. PROGRAM Oak_tree;
  2.  
  3. (*                 XXX     X    X   X  XXXXX  XXXX   XXXXX  XXXXX
  4.   July 14, 1986   X   X   X X   X  X     X    X   X  X      X
  5.                   X   X  X   X  X X      X    X   X  X      X
  6.                   X   X  X   X  XX       X    XXXX   XXX    XXX
  7.                   X   X  XXXXX  X X      X    X X    X      X
  8.                   X   X  X   X  X  X     X    X  X   X      X
  9.                    XXX   X   X  X   X    X    X   X  XXXXX  XXXXX
  10. *)
  11.  
  12. CONST  page_size = 66;
  13.        max_lines = 55;
  14.  
  15. TYPE   command_string = STRING[127];
  16.  
  17.        output_type = (directories,files);
  18.  
  19.        REGPACK = RECORD
  20.                  AX,BX,CX,DX,BP,SI,DI,DS,ES,FLAGS:INTEGER;
  21.                  END;
  22.  
  23.        dir_rec     = ^DIRTREE;     (* Dynamic storage for dir names *)
  24.        DIRTREE     = RECORD
  25.          next      : dir_rec;
  26.          dir_name  : STRING[15];
  27.       END;
  28.  
  29.        filerec     = ^FILETREE;          (* Dynamic storage for the *)
  30.        FILETREE    = RECORD              (* filename sorting tree   *)
  31.          left      : filerec;
  32.          right     : filerec;
  33.          CASE BOOLEAN OF
  34.          TRUE :  (attribute : BYTE;
  35.                   file_time : ARRAY[1..2] OF BYTE;
  36.                   file_date : ARRAY[1..2] OF BYTE;
  37.                   file_size : ARRAY[1..4] OF BYTE;
  38.                   file_name : ARRAY[1..13] OF CHAR);
  39.          FALSE : (file_rec  : ARRAY[1..23] OF CHAR);
  40.        END;
  41.  
  42. VAR   file_point     : filerec;        (* Pointer to a file record *)
  43.       page_number    : INTEGER;
  44.       line_number    : INTEGER;
  45.       directory_count : INTEGER;
  46.       recpack        : REGPACK;
  47.       dta            : ARRAY[1..43] OF CHAR;   (* Disk xfer address *)
  48.       file_request   : STRING[25];
  49.       root_mask      : command_string; (* Used for vol-label search *)
  50.       starting_path  : command_string;
  51.       cluster_size   : INTEGER;
  52.       sectors_per_cluster : INTEGER;
  53.       free_clusters  : INTEGER;
  54.       bytes_per_sector : INTEGER;
  55.       total_clusters : INTEGER;
  56.       do_we_print    : BOOLEAN;            (* Print or not          *)
  57.       do_all_stats   : BOOLEAN;            (* List all disk stats?  *)
  58.       no_files_out   : BOOLEAN;            (* List no files         *)
  59.       which_list     : output_type;
  60.       real_size      : REAL;
  61.       r1,r2,r3       : REAL;
  62.       total_cbytes   : REAL;
  63.       total_bytes    : REAL;
  64.       all_files      : INTEGER;
  65.       req_files      : INTEGER;
  66.  
  67. (* ***************************************************** Initialize *)
  68. (* This procedure is used to initialize some variables and strings  *)
  69. (* prior to starting the disk search.                               *)
  70. PROCEDURE initialize;
  71. BEGIN
  72.    page_number := 1;
  73.    line_number := 1;
  74.    directory_count := 0;
  75.    total_cbytes := 0;
  76.    total_bytes := 0;
  77.    all_files := 0;
  78.    req_files := 0;
  79.    root_mask := 'C:\*.*';
  80.    root_mask[length(root_mask) + 1] := chr(0);
  81.                             (* Get the current default drive letter *)
  82.    recpack.AX := $1900;
  83.    intr($21,recpack);
  84.    root_mask[1] := chr(recpack.AX AND $F + ord('A'));
  85. END;
  86.  
  87. (* ******************************* Read And Parse Command Arguments *)
  88. (* This procedure reads in the command line arguments, parses them, *)
  89. (* and sets up the switches and defaults for the disk searches.     *)
  90. PROCEDURE read_and_parse_command_arguments;
  91. VAR    parameters_input   : command_string ABSOLUTE CSEG:$80;
  92.        parameters         : command_string;
  93.        index              : BYTE;
  94.        temp_store         : CHAR;
  95. BEGIN
  96.    do_we_print := FALSE;
  97.    do_all_stats := FALSE;
  98.    no_files_out := FALSE;
  99.  
  100.             (* First, preserve the input area to allow F3 to repeat *)
  101.    FOR index := 0 TO length(parameters_input) DO
  102.       parameters[index] := parameters_input[index];
  103.    FOR index := 1 TO length(parameters) DO
  104.       BEGIN
  105.                                     (* Find designated drive letter *)
  106.       IF ((parameters[index] = ':') AND (index > 1)) THEN
  107.          BEGIN
  108.          root_mask[1] := parameters[index-1];
  109.          parameters[index-1] := ' ';
  110.          parameters[index] := ' ';
  111.          END;
  112.                                       (* Find command line switches *)
  113.       IF (parameters[index] = '/') AND (index < length(parameters))
  114.          THEN
  115.          BEGIN
  116.          temp_store := upcase(parameters[index + 1]);
  117.          IF temp_store = 'P' THEN do_we_print := TRUE;
  118.          IF temp_store = 'N' THEN no_files_out := TRUE;
  119.          IF temp_store = 'S' THEN do_all_stats := TRUE;
  120.          parameters[index] := ' ';
  121.          parameters[index+1] := ' ';
  122.          END;
  123.       END;
  124.                       (* get the current path on the selected drive *)
  125.       getdir(ord(root_mask[1])-ord('A') + 1,starting_path);
  126.       IF length(starting_path) > 3 THEN
  127.          starting_path := starting_path + '\';
  128.  
  129.                   (* Finally, find the file name mask for searching *)
  130.    REPEAT                                  (* Remove leading blanks *)
  131.       IF parameters[1] = ' ' THEN delete(parameters,1,1);
  132.    UNTIL (parameters[1] <> ' ') OR (length(parameters) = 0);
  133.  
  134.    index := 0;        (* Remove everything trailing the first entry *)
  135.    REPEAT
  136.       index := index + 1;
  137.    UNTIL (parameters[index] = ' ') OR (index=length(parameters) + 1);
  138.    delete(parameters,index,127);
  139.    IF parameters = '' THEN
  140.       file_request := '*.*'
  141.    ELSE
  142.       file_request := parameters;
  143. END;
  144.  
  145. (* ********************************************* count print lines *)
  146. PROCEDURE count_print_lines(line_count : BYTE);
  147. VAR count : BYTE;
  148. BEGIN
  149.    IF do_we_print THEN
  150.    BEGIN
  151.       IF line_count > 250 THEN (* This signals the end of the tree *)
  152.          BEGIN                 (* Space up to a new page           *)
  153.          FOR count := line_number TO (page_size - 3) DO
  154.             WRITELN(lst);
  155.          line_number := 1;
  156.          line_count := 0;
  157.          END;
  158.       line_number := line_number + line_count;
  159.       IF line_number > max_lines THEN
  160.          BEGIN
  161.          page_number := page_number +1;
  162.          FOR count := line_number TO (page_size - 2) DO
  163.             WRITELN(lst);
  164.          WRITELN(lst,'                           Page',page_number:4);
  165.          WRITELN(lst);
  166.          line_number := 1;
  167.          END;
  168.    END;
  169. END;
  170.  
  171. (* *************************************************** Print Header *)
  172. (* In this section of code, the volume label is found and displayed *)
  173. (* and the present time and date are determined and displayed.      *)
  174. PROCEDURE print_header;
  175. VAR month,day,hour,minute : STRING[2];
  176.     year                  : STRING[4];
  177.     error                 : INTEGER;
  178.     attribute             : BYTE;
  179.     temp                  : BYTE;
  180.     done                  : BOOLEAN;
  181.     index                 : INTEGER;
  182. BEGIN
  183.    IF do_we_print THEN
  184.       BEGIN
  185.       WRITELN(lst);
  186.       WRITELN(lst);
  187.       WRITELN(lst);
  188.       WRITE(lst,'          Directory for ');
  189.       END;
  190.    WRITE('          Directory for ');
  191.    recpack.AX := $1A00;                           (* Set up the DTA *)
  192.    recpack.DS := seg(dta);
  193.    recpack.DX := ofs(dta);
  194.    msdos(recpack);                            (* DTA setup complete *)
  195.    error := recpack.AX AND $FF;
  196.    IF error > 0 THEN WRITELN('DTA setup error ',error);
  197.  
  198.    recpack.AX := $4E00;                        (* Get the volume ID *)
  199.    recpack.DS := seg(root_mask[1]);
  200.    recpack.DX := ofs(root_mask[1]);
  201.    recpack.CX := 8;
  202.    intr($21,recpack);
  203.    error := recpack.AX AND $FF;
  204.    attribute := $1F AND mem[seg(dta):ofs(dta) + 21];
  205.  
  206.    IF ((error > 0) OR (attribute <> 8)) THEN
  207.       BEGIN
  208.       IF do_we_print THEN
  209.          WRITE(lst,' <no vol label> ');
  210.       WRITE(' <no vol label> ');
  211.       END
  212.    ELSE
  213.       BEGIN                               (* Write out Volume Label *)
  214.       done := FALSE;
  215.       FOR index := 30 TO 40 DO
  216.           BEGIN
  217.           temp := mem[seg(dta):ofs(dta) + index];
  218.           IF temp = 0 THEN done := TRUE;
  219.           IF done = FALSE THEN
  220.              BEGIN
  221.              IF do_we_print THEN
  222.                 WRITE(lst,chr(temp));
  223.              WRITE(chr(temp));
  224.              END;
  225.           END;
  226.       END;
  227.  
  228.    WRITE('             ');
  229.    IF do_we_print THEN
  230.       WRITE(lst,'             ');
  231.    recpack.AX := $2A00;                     (* Get the present date *)
  232.    msdos(recpack);
  233.    str(recpack.CX:4,Year);
  234.    str((recpack.DX MOD 256):2,day);
  235.    str((recpack.DX SHR 8):2,month);
  236.    IF day[1] = ' ' THEN day[1] := '0';
  237.    WRITE(month,'/',day,'/',year);
  238.    IF do_we_print THEN
  239.       WRITE(lst,month,'/',day,'/',year);
  240.    recpack.AX := $2C00;                    (* Get the present time *)
  241.    msdos(recpack);
  242.    str((recpack.CX SHR 8):2,hour);
  243.    str((recpack.CX MOD 256):2,minute);
  244.    IF minute[1] = ' ' THEN minute[1] := '0';
  245.    WRITELN('    ',hour,':',minute);
  246.    WRITELN;
  247.    IF do_we_print THEN
  248.       BEGIN
  249.       WRITELN(lst,'    ',hour,':',minute);
  250.       WRITELN(lst);
  251.       count_print_lines(2);
  252.       END;
  253.                                   (* get all of the disk constants *)
  254.    recpack.AX := $3600;
  255.    recpack.DX := (ord(root_mask[1]) - 64) AND $F;
  256.    msdos(recpack);
  257.    sectors_per_cluster := recpack.AX;
  258.    free_clusters := recpack.BX;
  259.    bytes_per_sector := recpack.CX;
  260.    total_clusters := recpack.DX;
  261.  
  262.    cluster_size := bytes_per_sector * sectors_per_cluster;
  263.  
  264.    IF do_all_stats THEN  (* Print out disk statistics if asked for *)
  265.       BEGIN
  266.       WRITE('             bytes/sector =',bytes_per_sector:6);
  267.       r1 := total_clusters;
  268.       r2 := cluster_size;
  269.       r1 := r1 *r2;
  270.       WRITELN('       total disk space =',r1:12:0);
  271.       WRITE('            bytes/cluster =',cluster_size:6);
  272.       r3 := free_clusters;
  273.       r2 := r3 * r2;
  274.       WRITELN('        free disk space =',r2:12:0);
  275.       WRITELN;
  276.       IF do_we_print THEN
  277.          BEGIN
  278.          WRITE(lst,'             bytes/sector =',bytes_per_sector:6);
  279.          WRITELN(lst,'       total disk space =',r1:12:0);
  280.          WRITE(lst,'            bytes/cluster =',cluster_size:6);
  281.          WRITELN(lst,'        free disk space =',r2:12:0);
  282.          WRITELN(lst);
  283.          count_print_lines(3);
  284.          END;
  285.       END;
  286. END;
  287.  
  288. (* *************************************** Position a new filename *)
  289. (* When a new filename is found, this routine is used to locate it *)
  290. (* in the B-TREE that will be used to sort the filenames alphabet- *)
  291. (* ically.                                                         *)
  292. PROCEDURE position_a_new_filename(root, new : filerec);
  293. VAR    index   : INTEGER;
  294.        done    : BOOLEAN;
  295. BEGIN
  296.    index := 1;
  297.    done := FALSE;
  298.    REPEAT
  299.       IF new^.file_name[index] < root^.file_name[index] THEN
  300.          BEGIN
  301.          done := TRUE;
  302.          IF root^.left = nil THEN root^.left := new
  303.          ELSE
  304.             position_a_new_filename(root^.left,new);
  305.          END
  306.       ELSE IF new^.file_name[index] > root^.file_name[index] THEN
  307.          BEGIN
  308.          done := TRUE;
  309.          IF root^.right = nil THEN root^.right := new
  310.          ELSE
  311.             position_a_new_filename(root^.right,new);
  312.          END;
  313.       index := index +1;
  314.    UNTIL (index = 13) OR done;
  315. END;
  316. (* *************************************************** Print a file *)
  317. (* This is used to print the data for one complete file.  It is     *)
  318. (* called with a pointer to the root and an attribute that is to be *)
  319. (* printed.  Either the directories are printed (attribute = $10),  *)
  320. (* or the files are printed.                                        *)
  321. PROCEDURE print_a_file(root : filerec;
  322.                        which_list : output_type);
  323. VAR index,temp : BYTE;
  324.     temp_string : STRING[25];
  325.     day         : STRING[2];
  326. BEGIN
  327.    temp := root^.attribute;
  328.    IF ((temp =  $10) AND (which_list = directories)) OR
  329.                         ((temp <> $10) AND (which_list = files)) THEN
  330.       BEGIN
  331.       WRITE('                ');
  332.       CASE temp OF
  333.          $27 : WRITE('<HID>  ');
  334.          $10 : WRITE('<DIR>  ');
  335.          $20 : WRITE('       ')
  336.          ELSE  WRITE('<',temp:3,'>  ');
  337.       END;   (* of CASE *)
  338.       IF do_we_print THEN
  339.          BEGIN
  340.          WRITE(lst,'                ');
  341.             CASE temp OF
  342.                $27 : WRITE(lst,'<HID>  ');
  343.                $10 : WRITE(lst,'<DIR>  ');
  344.                $20 : WRITE(lst,'       ')
  345.                ELSE  WRITE(lst,'<',temp:3,'>  ');
  346.             END;   (* of CASE *)
  347.          END;
  348.       temp_string := '               ';
  349.       index := 1;
  350.       REPEAT
  351.          temp := ord(root^.file_name[index]);
  352.          IF temp > 0 THEN
  353.             temp_string[index] := root^.file_name[index];
  354.          index := index + 1;
  355.       UNTIL (temp = 0) OR ( index = 14);
  356.       temp_string[0] := chr(15);
  357.       WRITE(temp_string);
  358.       IF do_we_print THEN
  359.          WRITE(lst,temp_string);
  360.  
  361.                                          (* Write out the file size *)
  362.       r1 := root^.file_size[1];
  363.       r2 := root^.file_size[2];
  364.       r3 := root^.file_size[3];
  365.       real_size := r3*65536.0 + r2 * 256.0 + r1;
  366.       WRITE(real_size:9:0);
  367.       IF do_we_print THEN
  368.          WRITE(lst,real_size:9:0);
  369.                                          (* Write out the file date *)
  370.       temp := ((root^.file_date[1] SHR 5) AND $7);
  371.       WRITE('   ',(temp + ((root^.file_date[2] AND 1) SHL 3)):2,'/');
  372.       IF do_we_print THEN
  373.       WRITE(lst,'   ',
  374.                     (temp+((root^.file_date[2] AND 1) SHL 3)):2,'/');
  375.       str((root^.file_date[1] AND $1F):2,day);
  376.       IF day[1] = ' ' THEN day[1] := '0';
  377.       WRITE(day,'/');
  378.       WRITE(80 + ((root^.file_date[2] SHR 1) AND $7F),'   ');
  379.       IF do_we_print THEN
  380.          BEGIN
  381.          WRITE(lst,day,'/');
  382.          WRITE(lst,80 + ((root^.file_date[2] SHR 1) AND $7F),'   ');
  383.          END;
  384.  
  385.                                          (* Write out the file time *)
  386.       WRITE('  ',((root^.file_time[2] SHR 3) AND $1F):2,':');
  387.       IF do_we_print THEN
  388.          WRITE(lst,'  ',((root^.file_time[2] SHR 3) AND $1F):2,':');
  389.       temp := ((root^.file_time[2]) AND $7) SHL 3;
  390.       str((temp + ((root^.file_time[1] SHR 5) AND $7)):2,day);
  391.       IF day[1] = ' ' THEN day[1] := '0';
  392.       WRITELN(day);
  393.       IF do_we_print THEN
  394.          BEGIN
  395.          WRITELN(lst,day);
  396.          count_print_lines(1);
  397.          END;
  398.       END;
  399.  
  400. END;
  401.  
  402. (* ********************************************** Print a directory *)
  403. (* This is a recursive routine to print out the filenames in alpha- *)
  404. (* betical order.  It uses a B-TREE with "infix" notation.  The     *)
  405. (* actual printing logic was removed to another procedure so that   *)
  406. (* the recursive part of the routine would not be too large and     *)
  407. (* up the heap too fast.                                            *)
  408. PROCEDURE print_a_directory(root         : filerec;
  409.                             which_list   : output_type);
  410. BEGIN
  411.    IF root^.left <> nil THEN
  412.       print_a_directory(root^.left,which_list);
  413.                                           (* Write out the filename *)
  414.    print_a_file(root,which_list);
  415.  
  416.    IF root^.right <> nil THEN
  417.       print_a_directory(root^.right,which_list);
  418. END;
  419.  
  420. (* ***************************************************** Erase tree *)
  421. (* After the directory is printed and counted, it must be erased or *)
  422. (* the "heap" may overflow for a large disk with a lot of files.    *)
  423. PROCEDURE erase_tree(root : filerec);
  424. BEGIN
  425.    IF root^.left  <> nil THEN erase_tree(root^.left);
  426.    IF root^.right <> nil THEN erase_tree(root^.right);
  427.    dispose(root);
  428. END;
  429.  
  430. (* ************************************************* Do A Directory *)
  431. (* This procedure reads all entries in any directory and sorts the  *)
  432. (* filenames alphabetically.  Then it prints out the complete stat- *)
  433. (* istics, and calls itself to do all of the same things for each   *)
  434. (* of its own subdirectories.  Since each subdirectory also calls   *)
  435. (* each of its subdirectories, the recursion continues until there  *)
  436. (* are no more subdirectories.                                      *)
  437. PROCEDURE do_a_directory(input_mask : command_string);
  438. VAR   mask          : command_string;
  439.       count,index   : INTEGER;
  440.       error         : BYTE;
  441.       cluster_count : INTEGER;
  442.       byte_count    : REAL;
  443.       tree_root     : filerec;                 (* Root of file tree *)
  444.       dir_root      : dir_rec;
  445.       dir_point     : dir_rec;
  446.       dir_last      : dir_rec;
  447.  
  448.     (* This embedded procedure is called upon to store all of the  *)
  449.     (* directory names in a linear linked list rather than a       *)
  450.     (* B-TREE since it should be rather short and efficiency of    *)
  451.     (* sorting is not an issue.  A bubble sort will be used on it. *)
  452.     PROCEDURE store_dir_name;
  453.     VAR temp_string : STRING[15];
  454.         temp        : BYTE;
  455.         index       : BYTE;
  456.     BEGIN
  457.        temp := mem[seg(dta):ofs(dta) + 21];           (* Attribute *)
  458.        IF temp = $10 THEN  (* Pick out directories *)
  459.           BEGIN
  460.           index := 1;
  461.           REPEAT
  462.              temp := mem[seg(dta):ofs(dta) + 29 + index];
  463.              IF temp > 0 THEN
  464.                 temp_string[index] := chr(temp);
  465.              index := index + 1;
  466.           UNTIL (temp = 0) OR (index = 14);
  467.           temp_string[0] := chr(index - 2);
  468.                      (* Directory name found, ignore if it is a '.' *)
  469.           IF temp_string[1] <> '.' THEN
  470.              BEGIN
  471.              new(dir_point);
  472.              dir_point^.dir_name := temp_string;
  473.              dir_point^.next := nil;
  474.              IF dir_root = nil THEN
  475.                 dir_root := dir_point
  476.              ELSE
  477.                 dir_last^.next := dir_point;
  478.              dir_last := dir_point;
  479.              END;
  480.           END;
  481.      END;
  482.  
  483.      (* This is the procedure that sorts the directory names after *)
  484.      (* they are all accumulated.  It uses a bubble sort technique *)
  485.      (* which is probably the most inefficient sort available.  It *)
  486.      (* is perfectly acceptable for what is expected to be a very  *)
  487.      (* short list each time it is called.  More than 30 or 40     *)
  488.      (* subdirectories in one directory would not be good practice *)
  489.      (* but this routine would sort any number given to it.        *)
  490.      PROCEDURE sort_dir_names;
  491.      VAR change      : BYTE;
  492.          save_string : STRING[15];
  493.          dir_next    : dir_rec;
  494.      BEGIN
  495.         REPEAT
  496.            change := 0;
  497.            dir_point := dir_root;
  498.            WHILE dir_point^.next <> nil DO
  499.               BEGIN
  500.               dir_next := dir_point^.next;
  501.               save_string := dir_next^.dir_name;
  502.               IF save_string < dir_point^.dir_name THEN
  503.                  BEGIN
  504.                  dir_next^.dir_name := dir_point^.dir_name;
  505.                  dir_point^.dir_name := save_string;
  506.                  change := 1;
  507.                  END;
  508.               dir_point := dir_point^.next;
  509.               END;
  510.         UNTIL change = 0;    (* No swaps in this pass, we are done *)
  511.      END;
  512.  
  513. BEGIN
  514.    count := 0;
  515.    cluster_count := 0;
  516.    dir_root := nil;
  517.    mask := input_mask + '*.*';
  518.    mask[length(mask) + 1] := chr(0);     (* A trailing zero for DOS *)
  519.                                     (* Count all files and clusters *)
  520.    REPEAT
  521.       IF count = 0 THEN
  522.          BEGIN                         (* Get first directory entry *)
  523.          recpack.AX := $4E00;
  524.          recpack.DS := seg(mask[1]);
  525.          recpack.DX := ofs(mask[1]);
  526.          recpack.CX := $17;             (* Attribute for all files *)
  527.          intr($21,recpack);
  528.          END
  529.       ELSE
  530.          BEGIN                 (* Get additional directory entries *)
  531.          recpack.AX := $4F00;
  532.          intr($21,recpack);
  533.          END;
  534.       error := recpack.AX AND $FF;
  535.       IF error = 0 THEN                (* A good filename is found *)
  536.          BEGIN
  537.          count := count +1;            (* Add one for a good entry *)
  538.  
  539.                            (* Count up the number of clusters used *)
  540.          r1 := mem[seg(dta):ofs(dta) + 26];
  541.          r2 := mem[seg(dta):ofs(dta) + 27];
  542.          r3 := mem[seg(dta):ofs(dta) + 28];
  543.          real_size := r3*65536.0 + r2 * 256.0 + r1; (*Nmbr of bytes*)
  544.          r1 := cluster_size;
  545.          r1 := real_size/r1;                 (* Number of clusters *)
  546.          index := trunc(r1);
  547.          r2 := index;
  548.          IF (r1 - r2) > 0.0 THEN
  549.             index := index +1;             (* If a fractional part *)
  550.          cluster_count := cluster_count + index;
  551.          IF index = 0 THEN     (* This is a directory, one cluster *)
  552.             cluster_count := cluster_count +1;
  553.          store_dir_name;
  554.          END;
  555.    UNTIL error > 0;
  556.    r1 := cluster_count;
  557.    r2 := cluster_size;
  558.    r1 := r1 * r2;
  559.    directory_count := directory_count + 1;
  560.    WRITE('    ',directory_count:3,'. ');
  561.    WRITE(input_mask);
  562.    FOR index := 1 TO (32 - length(input_mask)) DO WRITE(' ');
  563.    WRITELN(count:4,' Files  Cbytes =',r1:9:0);
  564.    IF do_we_print THEN
  565.       BEGIN
  566.       WRITE(lst,'    ',directory_count:3,'. ');
  567.       WRITE(lst,input_mask);
  568.       FOR index := 1 TO (32 - length(input_mask)) DO WRITE(lst,' ');
  569.       WRITELN(lst,count:4,' Files  Cbytes =',r1:9:0);
  570.       count_print_lines(1);
  571.       END;
  572.    total_cbytes := total_cbytes + r1;
  573.    all_files := all_files + count;
  574.  
  575.                             (* files counted and clusters counted   *)
  576.                             (* Now read in only the requested files *)
  577.  
  578.    count := 0;
  579.    byte_count := 0;
  580.    tree_root := nil;
  581.    IF no_files_out <> TRUE THEN
  582.       BEGIN
  583.       mask := input_mask + file_request;
  584.       mask[length(mask) + 1] := chr(0); (* A trailing zero for DOS *)
  585.       REPEAT
  586.          new(file_point);
  587.          IF count = 0 THEN
  588.             BEGIN                     (* Get first directory entry *)
  589.             recpack.AX := $4E00;
  590.             recpack.DS := seg(mask[1]);
  591.             recpack.DX := ofs(mask[1]);
  592.             recpack.CX := $17;          (* Attribute for all files *)
  593.             intr($21,recpack);
  594.             END
  595.          ELSE
  596.             BEGIN              (* Get additional directory entries *)
  597.             recpack.AX := $4F00;
  598.             intr($21,recpack);
  599.             END;
  600.          error := recpack.AX AND $FF;
  601.          IF error = 0 THEN             (* A good filename is found *)
  602.             BEGIN
  603.             count := count +1;         (* Add one for a good entry *)
  604.             file_point^.left := nil;
  605.             file_point^.right := nil;
  606.             FOR index := 1 TO 23 DO
  607.                file_point^.file_rec[index] :=
  608.                            char(mem[seg(dta):ofs(dta) + 20 + index]);
  609.             IF tree_root = nil THEN
  610.                BEGIN             (* Point to first element in tree *)
  611.                tree_root := file_point;
  612.                END
  613.             ELSE
  614.                BEGIN       (* Point to additional elements in tree *)
  615.                   position_a_new_filename(tree_root,file_point);
  616.                END;
  617.  
  618.                               (* Count up the number of bytes used *)
  619.             r1 := file_point^.file_size[1];
  620.             r2 := file_point^.file_size[2];
  621.             r3 := file_point^.file_size[3];
  622.             real_size := r3*65536.0 + r2 * 256.0 + r1; (*Number of *)
  623.                                                     (* bytes used. *)
  624.             byte_count := byte_count + real_size;
  625.             END;
  626.       UNTIL error > 0;
  627.    END;
  628.  
  629.    which_list := directories;
  630.    IF tree_root <> nil THEN
  631.       print_a_directory(tree_root,which_list);
  632.    IF tree_root <> nil THEN
  633.       print_a_directory(tree_root,succ(which_list));
  634.    IF count > 0 THEN
  635.       BEGIN
  636.       WRITELN('                  ',count:5,' Files ',
  637.                                  byte_count:17:0,' Bytes');
  638.       WRITELN;
  639.       IF do_we_print THEN
  640.          BEGIN
  641.          WRITELN(lst,'                  ',count:5,' Files ',
  642.                                     byte_count:17:0,' Bytes');
  643.          WRITELN(lst);
  644.          count_print_lines(2);
  645.          END;
  646.       total_bytes := total_bytes + byte_count;
  647.       req_files := req_files + count;
  648.       END;
  649.                             (* Now go do all of the subdirectories *)
  650.    IF dir_root <> nil THEN sort_dir_names;
  651.    dir_point := dir_root;
  652.    WHILE dir_point <> nil DO
  653.       BEGIN
  654.       mask := input_mask + dir_point^.dir_name + '\';
  655.       do_a_directory(mask);
  656.       dir_point := dir_point^.next;
  657.       END;
  658.                            (* Finally, erase the tree and the list *)
  659.    IF tree_root <> nil THEN
  660.       erase_tree(tree_root);
  661.  
  662.    WHILE dir_root <> nil DO
  663.       BEGIN
  664.       dir_point := dir_root^.next;
  665.       dispose(dir_root);
  666.       dir_root := dir_point;
  667.       END;
  668. END;
  669.  
  670. (* ******************************************* Output Summary Data *)
  671. PROCEDURE output_summary_data;
  672. BEGIN
  673.    WRITELN;
  674.    WRITE('                     ',req_files:5,' Files');
  675.    WRITELN(total_bytes:15:0,' Bytes in request');
  676.    WRITE('                     ',all_files:5,' Files');
  677.    WRITELN(total_cbytes:15:0,' Cbytes in tree');
  678.    WRITE('                                   ');
  679.    r1 := free_clusters;
  680.    r2 := cluster_size;
  681.    r1 := r1 * r2;
  682.    WRITELN(r1:12:0,' Bytes free on disk');
  683.    IF do_we_print THEN
  684.       BEGIN
  685.       WRITELN(lst);
  686.       WRITE(lst,'                     ',req_files:5,' Files');
  687.       WRITELN(lst,total_bytes:15:0,' Bytes in request');
  688.       WRITE(lst,'                     ',all_files:5,' Files');
  689.       WRITELN(lst,total_cbytes:15:0,' Cbytes in tree');
  690.       WRITE(lst,'                                   ');
  691.       WRITELN(lst,r1:12:0,' Bytes free on disk');
  692.       count_print_lines(4);      (* Signal the end, space paper up *)
  693.       END;
  694. END;
  695.  
  696. BEGIN  (* Main program - Oak Tree ********************************* *)
  697.   initialize;
  698.   read_and_parse_command_arguments;
  699.   print_header;
  700.   do_a_directory(starting_path);
  701.   output_summary_data;
  702.   count_print_lines(255);
  703. END.  (* Main Program *)
  704.